Transformare de cuvinte (Delia Garbacea)
Baraj Bucuresti, mai 1995
Dificultate: C2

	Se urmareste transformarea unui cuvant sursa intr-un cuvant destinatie 
folosind urmatoarele operatii permise:

COPY(a)           - copiaza caracterul a din sursa in destinatie
DELETE(a)         - sterge caracterul a din sursa
INSERT(a)         - insereaza caracterul a in destinatie
REPLACE(a,b)      - inlocuieste caracterul a cu caracterul b
                  (a dispare din sursa iar in destinatie apare b)
TWIDDLE(ab)       - secventa ab din sursa se transforma in ba in destinatie
                  (ab dispare din sursa si apare ba in destinatie)
KILL(secventa)    - dupa ce s-au efectuat toate operatiile necesare, se poate
                  elimina secventa ramasa (sufixul) din cuvantul sursa.

Exemplu: 
	Pentru transformarea cuvantului sursa ALGORITHM in cuvantul
destinatie ALTRUISTIC, se poate folosi urmatoarea secventa de operatii:

operatie                           destinatie         sursa
----------------------------------------------------------------------------
copy(a)                                               algorithm
copy(l)                           al                  gorithm
replace(g,t)                      alt                 orithm
delete(o)                         alt                 rithm
copy(r)                           altr                ithm
insert(u)                         altru               ithm
insert(i)                         altrui              ithm
insert(s)                         altruis             ithm
twiddle(it)                       altruisti           hm
insert(c)                         altruistic          hm
kill(hm)                          altruistic

   Asociind cate un cost fiecarei operatii, problema cere sa se determine o
secventa de operatii de cost minim (suma costurilor operatiilor sa fie minima).

INTRAREA.
	Datele se citesc dintr-un fisier text al carui nume se citeste de la
tastatura si are urmatoarea structura:
- pe prima linie sunt sase numere naturale (byte) reprezentand, in ordine,
costurile operatiilor: copy, delete, insert, replace, twiddle, kill;
- fiecare dintre liniile urmatoare contine cate doua cuvinte separate
printr-un spatiu, reprezentand sursa respectiv destinatia.

IESIREA.
	In fisierul text TRANS.OUT se va afisa pentru fiecare pereche de
cuvinte sursa-destinatie un tabel ca si cel din exemplu, urmat de costul
transformarii.
====================================

Solutia 1 (Mihai Stroe)
    Am mai rezolvat aceasta problema (si alte variante); totusi am reluat-o.
    Metoda este clasica: programare dinamica, construirea unei matrici in care
  pe pozitia (i,j) e memorat costul optim al transformarii primelor i litere
  din primul sir in primele j litere din cel de-al doilea sir. Afisarea e
  realizata recursiv, pe baza pastrarii la fiecare (i,j)-pas a operatiei care
  conduce la optimul de la pasul respectiv. Operatia KILL nu intra in
  construirea matricii, ci este aplicata dupa aceasta.

var s1,s2:string;
    c1,c2,c3,c4,c5,c6:integer;
    i,j,k,l,m,n,min:integer;
    a,t:array[0..100,0..100]of byte;
    fi,fo:text;
    s:string;
    c:char;

procedure readdata;
begin
  s1:='';
  s2:='';
  fillchar(a,sizeof(a),0);
  read(fi,c);
  while c<>' ' do
    begin
      s1:=s1+c;
      read(fi,c);
    end;
  readln(fi,s2);
end;

procedure rec(i,j:integer);
begin
  case t[i,j] of
    1: begin
         rec(i-1,j-1);
         write(fo,'copy(',s1[i],')    ',copy(s2,1,j),'    ',copy(s1,i+1,length(s1)-i+1));
       end;
    2: begin
         rec(i-1,j);
         write(fo,'delete(',s1[i],')    ',copy(s2,1,j),'    ',copy(s1,i+1,length(s1)-i+1));
       end;
    3: begin
         rec(i,j-1);
         write(fo,'insert(',s2[j],')    ',copy(s2,1,j),'    ',copy(s1,i+1,length(s1)-i+1));
       end;
    4: begin
         rec(i-1,j-1);
         write(fo,'replace(',s1[i],',',s2[j],')    ',copy(s2,1,j),'    ',copy(s1,i+1,length(s1)-i+1));
       end;
    5: begin
         rec(i-2,j-2);
         write(fo,'twiddle(',s1[i],s2[i],')    ',copy(s2,1,j),'    ',copy(s1,i+1,length(s1)-i+1));
       end;
  end;
  if i+j<>0 then writeln(fo);
end;

procedure solve;
begin
  for i:=1 to length(s1) do
      a[i,0]:=i*c2;
  for i:=1 to length(s2) do
      a[0,i]:=i*c3;
  for i:=1 to length(s1) do
      for j:=1 to length(s2) do
          begin
            min:=10000;
            if s1[i]=s2[j] then
               if min>c1+a[i-1,j-1] then
                  begin
                    min:=c1+a[i-1,j-1];
                    t[i,j]:=1;
                  end;
            if min>c4+a[i-1,j-1] then
               begin
                 min:=c4+a[i-1,j-1];
                 t[i,j]:=4;
               end;
            if min>c2+a[i-1,j] then
               begin
                 min:=c2+a[i-1,j];
                 t[i,j]:=2;
               end;
            if min>c3+a[i,j-1] then
               begin
                 min:=c2+a[i,j-1];
                 t[i,j]:=3;
               end;
            if i>1 then
            if j>1 then
            if s1[i]=s2[j] then
            if s1[i-1]=s2[j-1] then
            if min>c3+a[i-2,j-2] then
               begin
                 min:=c2+a[i-2,j-2];
                 t[i,j]:=5;
               end;
            a[i,j]:=min;
          end;
  min:=a[length(s1),length(s2)];m:=length(s1);
  for i:=1 to length(s1)-1 do
      if a[i,length(s2)]+c6<min then
         begin
           m:=i;
           min:=a[i,length(s2)]+c6;
         end;
  n:=length(s2);
  rec(m,n);
  if m<length(s1) then writeln(fo,'kill(',copy(s1,m+1,length(s1)-m+1),')      ',s2,'  ');
  writeln(fo,a[m,n]);
end;

begin
  write('Type input file name ');
  readln(s);
  assign(fi,s);
  assign(fo,'trans.out');
  reset(fi);
  rewrite(fo);
  readln(fi,c1,c2,c3,c4,c5,c6);
  while not seekeof(fi) do
    begin
      readdata;
      solve;
    end;
  close(fi);
  close(fo);
end.
----------------------------
Solutia 2 (Catalin Francu)
program Transform;
{$B-,I-,R-,S-}
var CC,CD,CI,CK,CR,CT,CSum:Integer;
    Source,Dest,Process,InName,OutName:String;

procedure ReadWords;
var i:Integer;
begin
  ReadLn(Dest);
  i:=Pos(' ',Dest);
  Source:=Copy(Dest,1,i-1);
  Delete(Dest,1,i);
end;

procedure Dist(var S1,S2:String;var Cost:Integer;var Process:String);
var i,NewCost:Integer;
    C1,C2:Char;
    P:String;
begin
  if S1='' then begin
                  Cost:=CI*Length(S2);
                  Process:='';
                  for i:=1 to Length(S2) do Process:=Process+'I';
                  Exit;
                end;
  if S2='' then begin
                  Cost:=CK;
                  Process:='K';
                  Exit;
                end;
  if S1[1]=S2[1] then begin
                        C1:=S1[1];
                        Delete(S1,1,1);
                        Delete(S2,1,1);
                        Dist(S1,S2,Cost,Process);
                        Inc(Cost,CC);
                        Process:='C'+Process;
                        S1:=C1+S1;
                        S2:=C1+S2;
                        Exit;
                      end;
  if (S1[0]>#1) and (S2[0]>#1) and (S1[1]=S2[2]) and (S1[2]=S2[1])
    then begin
           C1:=S1[1];
           C2:=S1[2];
           Delete(S1,1,2);
           Delete(S2,1,2);
           Dist(S1,S2,Cost,Process);
           Inc(Cost,CT);
           Process:='T'+Process;
           S1:=C1+C2+S1;
           S2:=C2+C1+S2;
           Exit;
         end;
  { Replace }
  C1:=S1[1];
  C2:=S2[1];
  Delete(S1,1,1);
  Delete(S2,1,1);
  Dist(S1,S2,Cost,Process);
  Inc(Cost,CR);
  Process:='R'+Process;
  S1:=C1+S1;
  S2:=C2+S2;
  { Insert }
  C1:=S2[1];
  Delete(S2,1,1);
  Dist(S1,S2,NewCost,P);
  Inc(NewCost,CI);
  P:='I'+P;
  S2:=C1+S2;
  if NewCost<Cost then begin
                         Cost:=NewCost;
                         Process:=P;
                       end;
  { Delete }
  C1:=S1[1];
  Delete(S1,1,1);
  Dist(S1,S2,NewCost,P);
  Inc(NewCost,CD);
  P:='D'+P;
  S1:=C1+S1;
  if NewCost<Cost then begin
                         Cost:=NewCost;
                         Process:=P;
                       end;
end;

procedure Interpret;
var S:String;
    i:Integer;
begin
  S:='';
  WriteLn('Transformarea ',Source,' -> ',Dest,' are costul ',CSum);
  WriteLn('--------------------------------------------------');
  for i:=1 to Length(Process) do
    begin
      case Process[i] of
        'C':begin
              Write('copy(',Source[1],')');
              S:=S+Source[1];
              Delete(Source,1,1);
            end;
        'D':begin
              Write('delete(',Source[1],')');
              Delete(Source,1,1);
            end;
        'I':begin
              Write('insert(',Dest[Length(S)+1],')');
              S:=S+Dest[Length(S)+1];
            end;
        'K':begin
              Write('kill(',Source,')');
              Source:=''
            end;
        'R':begin
              Write('replace(',Source[1],',',Dest[Length(S)+1],')');
              S:=S+Dest[Length(S)+1];
              Delete(Source,1,1);
            end;
        'T':begin
              Write('twiddle(',Source[1],Source[2],')');
              S:=S+Source[2]+Source[1];
              Delete(Source,1,2);
            end;
      end; {case}
      WriteLn(' ',S,' ',Source);
    end;
  WriteLn;
end;

begin
  Write('Numele fisierului de intrare: ');ReadLn(InName);
  Write('Numele fisierului de iesire: ');ReadLn(OutName);
  Assign(Input,InName);Reset(Input);
  Assign(Output,OutName);Rewrite(Output);
  ReadLn(CC,CD,CI,CR,CT,CK);
  while not Eof do
    begin
      ReadWords;
      Dist(Source,Dest,CSum,Process);
      Interpret;
    end;
  Close(Input);Close(Output);
end.
-----------------------------------------
Solutia 3 (Vlad Marius)
program Transformare_de_cuvinte;
{ Vlad Marius - Transformare de cuvinte }
uses crt;
type tip=record
       cost:integer;
       op:char;
      end;
var i,j,k,n,m:integer;
    cc,cd,ci,cr,ct,ck:integer;
    a:array[0..100,0..100] of tip;
    sav:array[1..100] of tip;
    savi,savj:array[1..100] of byte;
    f,fo:text;
    s,d:string;

procedure spac(i:integer);
  var j:integer;
 begin
  for j:=1 to i do write(fo,' ');
 end;

begin
clrscr;
write('File IN : ');
readln(s);
assign(f,s);
reset(f);
assign(fo,'trans.out');
rewrite(fo);
readln(f,cc,cd,ci,cr,ct,ck);
while not eof(f) do
 begin
  readln(f,d);
  s:=copy(d,1,pos(' ',d)-1);
  delete(d,1,pos(' ',d));
  n:=length(d);
  m:=length(s);
  a[0,0].cost:=0;
  a[0,0].op:=' ';
  for i:=0 to n do
   for j:=0 to m do if not ((i=0) and (j=0)) then
    begin
     a[i,j].cost:=maxint;
     a[0,0].cost:=0;
     if (j>0) and (a[i,j-1].cost+cd<a[i,j].cost) then
      begin
       a[i,j].cost:=a[i,j-1].cost+cd;
       a[i,j].op:='D';
      end;
     if (i>0) and (a[i-1,j].cost+ci<a[i,j].cost) then
      begin
       a[i,j].cost:=a[i-1,j].cost+ci;
       a[i,j].op:='I';
      end;
     if (i>0) and (j>0) and (a[i-1,j-1].cost+cc<a[i,j].cost) and (s[j]=d[i]) then
      begin
       a[i,j].cost:=a[i-1,j-1].cost+cc;
       a[i,j].op:='C';
      end;
     if (i>0) and (j>0) and (a[i-1,j-1].cost+cr<a[i,j].cost)then
      begin
       a[i,j].cost:=a[i-1,j-1].cost+cr;
       a[i,j].op:='R';
      end;
     if (i>1) and (j>1) and (a[i-2,j-2].cost+ct<a[i,j].cost) and (s[j-1]=d[i]) and (s[j]=d[i-1]) then
      begin
       a[i,j].cost:=a[i-2,j-2].cost+ct;
       a[i,j].op:='T';
      end;
    end;
  for k:=1 to m-1 do if a[n,k].cost+ck<a[n,j].cost then j:=k;
  k:=0;
  while (i<>0) or (j<>0) do
   begin
    k:=k+1;
    sav[k]:=a[i,j];
    savi[k]:=i;
    savj[k]:=j;
    case a[i,j].op of
     'C','R':begin i:=i-1; j:=j-1; end;
     'I':i:=i-1;
     'D':j:=j-1;
     'T':begin i:=i-2; j:=j-2; end;
    end;
   end;
  writeln(fo,'Operatia            Destinatia                    Sursa                       ');
  writeln(fo,'-------------------------------------------------------------------------------');
  spac(50);
  writeln(fo,s);
  for i:=k downto 1 do
   begin
    case sav[i].op of
      'C':begin
           write(fo,'copy('+d[savi[i]]+')');
           spac(20-length('copy('+d[savi[i]]+')'));
          end;
      'I':begin
           write(fo,'insert('+d[savi[i]]+')');
           spac(20-length('insert('+d[savi[i]]+')'));
          end;
      'D':begin
           write(fo,'delete('+s[savj[i]]+')');
           spac(20-length('delete('+s[savj[i]]+')'));
          end;
      'R':begin
           write(fo,'replace('+s[savj[i]]+','+d[savi[i]]+')');
           spac(20-length('replace('+s[savj[i]]+','+d[savi[i]]+')'));
          end;
      'T':begin
           write(fo,'twiddle('+s[savj[i]-1]+s[savj[i]]+')');
           spac(20-length('twiddle('+s[savj[i]-1]+s[savj[i]]+')'));
          end;
     end;
    write(fo,copy(d,1,savi[i]));
    spac(30-length(copy(d,1,savi[i])));
    write(fo,copy(s,savj[i]+1,m-savj[i]));
    writeln(fo);
   end;
  if savj[1]<m then
   begin
    write(fo,'kill('+copy(s,savj[1]+1,m-savj[1])+')');
    spac(20-length('kill('+copy(s,savj[1]+1,m-savj[1])+')'));
    writeln(fo,d);
   end;
  write(fo,'  COST TOTAL : ');
  if savj[1]=m then writeln(fo,sav[1].cost) else writeln(fo,sav[1].cost+ck);
  writeln(fo);
 end;
close(f);
close(fo);
end.
---------------------------------------------
Solutia 4 (Mihai Badoiu)
var
	copy_cost,replace_cost,delete_cost,insert_cost,twiddle_cost,kill_cost
	:integer;
	a,b:string;
	v:array[0..50,0..50] of byte;
	p:array[0..50,0..50] of byte;
	LAST:integer;

procedure load;
var
	f:text;
begin
	assign(f,'transf.in');
	reset(f);
	readln(f,copy_cost);
	readln(f,replace_cost);
	readln(f,delete_cost);
	readln(f,insert_cost);
	readln(f,twiddle_cost);
	readln(f,kill_cost);
	readln(f,a);
	readln(f,b);
	close(f);
end;

procedure expand(i,j:integer);
begin
{COPY}
	if a[i+1]=b[j+1] then
	begin
		if v[i+1,j+1]>v[i,j]+copy_cost then
		begin
			v[i+1,j+1]:=v[i,j]+copy_cost;
			p[i+1,j+1]:=1;
			end;
		end;
{REPLACE}
	if v[i+1,j+1]>v[i,j]+replace_cost then
	begin
		v[i+1,j+1]:=v[i,j]+replace_cost;
		p[i+1,j+1]:=2;
		end;
{DELETE}
	if v[i,j+1]>v[i,j]+delete_cost then
	begin
		v[i,j+1]:=v[i,j]+delete_cost;
		p[i,j+1]:=3;
		end;
{INSERT}
	if v[i+1,j]>v[i,j]+insert_cost then
	begin
		v[i+1,j]:=v[i,j]+insert_cost;
		p[i+1,j]:=4;
		end;
{TWIDDLE}
	if (a[i+1]=b[j+2]) and (a[i+2]=b[j+1]) then
	if v[i+2,j+2]>v[i,j]+twiddle_cost then
	begin
		v[i+2,j+2]:=v[i,j]+twiddle_cost;
		p[i+2,j+2]:=5;
		end;
end;

procedure calcul;
var
	i,j:integer;
begin
	for i:=0 to length(a) do
		for j:=0 to length(b) do
		if v[i,j]<>200 then
			expand(i,j);
{  calcul_kill  }
	LAST:=length(b);
	for i:=1 to length(b)-1 do
		if v[length(a),length(b)]>v[length(a),i]+kill_cost then
		begin
			v[length(a),length(b)]:=v[length(a),i]+kill_cost;
			LAST:=i;
			end;
end;

procedure init;
var
	i,j:integer;
begin
	for i:=0 to length(a) do
		for j:=0 to length(b) do
			v[i,j]:=200;
	v[0,0]:=0;
end;

procedure scrie;
var
	x:array[1..50] of byte;
	i,j,k,virf:integer;
begin
	writeln(v[length(a),length(b)]);
	i:=length(a);
	j:=LAST;
	virf:=0;
	while (i<>0) or (j<>0) do
	begin
		case p[i,j] of
			1:begin
					inc(virf);
					x[virf]:=p[i,j];
					dec(i);
					dec(j);
					end;
			2:begin
					inc(virf);
					x[virf]:=p[i,j];
					dec(i);
					dec(j);
					end;
			3:begin
					inc(virf);
					x[virf]:=p[i,j];
					dec(j);
					end;
			4:begin
					inc(virf);
					x[virf]:=p[i,j];
					dec(i);
					end;
			5:begin
					inc(virf);
					x[virf]:=p[i,j];
					dec(i,2);
					dec(j,2);
					end;
			end;
		end;
	for k:=virf downto 1 do
	begin
		case x[k] of
			1:begin
					inc(i);
					inc(j);
					write('copy ',a[i],'':9);
					end;
			2:begin
					inc(i);
					inc(j);
					write('replace ',b[j],' by ',a[i],'':1);
					end;
			3:begin
					inc(j);
					write('delete ',b[j],'':7);
					end;
			4:begin
					inc(i);
					write('insert ',a[i],'':7);
					end;
			5:begin
					inc(i,2);
					inc(j,2);
					write('twiddle ',b[j-1],b[j],'':5);
					end;
			end;
		writeln(copy(a,1,i),' ':(15-i),copy(b,j+1,length(b)-j+1));
		end;
	if LAST<>length(b) then
		writeln('kill','':11,a);
end;

begin
	writeln;
	load;
	init;
	calcul;
	scrie;
end.
-----------------------------------------
Solutia 5 (Mihai Stroe)
    Problema este clasica, dar se introduc noi operatii (twiddle,kill) si
  se asociaza un cost fiecarei operatii. Aceasta nu impiedica o rezolvare in
  n^2. Costul optim pentru transformarea subsirului SURSA[1..i] in DEST[1..j]
  fara operatia KILL se obtine din costurile optime pentru (i-2,j-2),(i-1,j-1)
  (i-1,j) si (i,j-1). Se completeaza astfel matricea costurilor optime.
    In final se aplica operatia KILL pentru obtinerea, daca e posibil, a unui
  cost mai mic.

var s1,s2:string;
    a,b:array[0..100,0..100]of byte;
    jj,mm,ii,i,copy,delet,insert,replace,twiddle,kill,j,k,l,m,n,min,io:word;
    fi,fo:text;
    ss,sd,s:string;

procedure rec(i,j:byte);
begin
  case b[i,j]of
     1:begin
         rec(i-1,j-1);
         delete(ss,1,1);
         sd:=sd+s1[i];
         writeln('copy(',s1[i],')        ',ss,'       ',sd);
       end;
     2:begin
         rec(i-1,j);
         delete(ss,1,1);
         writeln('delete(',s1[i],')      ',ss,'        ',sd);
       end;
     3:begin
         rec(i,j-1);
         sd:=sd+s2[j];
         writeln('insert(',s2[j],')      ',ss,'        ',sd);
       end;
     4:begin
         rec(i-1,j-1);
         delete(ss,1,1);
         sd:=sd+s2[j];
         writeln('replace(',s1[i],',',s2[j],')   ',ss,'     ',sd);
       end;
     5:begin
         rec(i-2,j-2);
         delete(ss,1,2);
         sd:=sd+s1[i]+s1[i-1];
         writeln('twiddle(',s1[i-1],',',s1[i],')   ',ss,'     ',sd);
       end;
  end;
end;

procedure solve;
begin
  m:=length(s1);
  fillchar(a,sizeof(a),0);
  n:=length(s2);
  for i:=1 to m do a[i,0]:=200;
  for i:=1 to n do a[0,i]:=200;
  for i:=1 to m do
      for j:=1 to n do
          begin
            min:=200;
            if s1[i]=s2[j] then if copy+a[i-1,j-1]<min then
               begin
                 min:=a[i-1,j-1]+copy;
                 b[i,j]:=1;
               end;
            if insert+a[i,j-1]<min then
               begin
                 min:=insert+a[i,j-1];
                 b[i,j]:=3;
               end;
            if delet+a[i-1,j]<min then
               begin
                 min:=delet+a[i-1,j];
                 b[i,j]:=2;
               end;
            if replace+a[i-1,j-1]<min then
               begin
                 min:=a[i-1,j-1]+replace;
                 b[i,j]:=4;
               end;
            if(i>2)and(j>2) then
            if s1[i]=s2[j-1] then if s1[i-1]=s2[j]
               then if twiddle+a[i-2,j-2]<min then
               begin
                 min:=twiddle+a[i-2,j-2];
                 b[i,j]:=5;
               end;
            if(i=2)or(j=2) then
            begin
              a[i-2,j-2]:=0;
              if s1[i]=s2[j-1] then if s1[i-1]=s2[j] then
              if twiddle+a[i-2,j-2]<min then
                begin
                  min:=twiddle+a[i-2,j-2];
                  b[i,j]:=5;
                end;
              a[i-2,j-2]:=200;
            end;
            a[i,j]:=min;
          end;
  min:=a[m,n];jj:=m;
  for ii:=1 to m-1 do
      if a[ii,n]+kill<min then begin min:=a[ii,n]+kill;jj:=ii;end;
  ss:=s1;
  sd:='';
  rec(jj,n);
  if jj<>m then write('kill(',ss,')                  ',sd);
end;

begin
  write('Introduceti numele fisierului de intrare ');
  readln(s);
  assign(fi,s);
  reset(fi);
  readln(fi,copy,delet,insert,replace,twiddle,kill);
  while not seekeof(fi)do
    begin
      readln(fi,s1);
      i:=1;
      while s1[i]<>' 'do inc(i);
      s2:=s1;
      delete(s2,1,i);
      delete(s1,i,length(s1)-i+1);
      solve;
    end;
  close(fi);
end.
-----------------------
